perm filename NETWRK.MID[NET,MRC]12 blob
sn#374136 filedate 1978-08-14 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00032 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00004 00002 Network routines, intended to be .INSRT'ed
C00007 00003 System bits and bytes
C00010 00004 Data area
C00012 00005 More data area, shared by USER and SERVER
C00014 00006 CONECT -- Connect to foreign host
C00017 00007 Got socket number from logger
C00020 00008 LISTEN -- Listen for an ICP from a foreign host
C00023 00009 Sent socket number to user
C00026 00010 DATI -- Open data input network channel
C00028 00011 DATO -- Open data output network channel
C00030 00012 NETICH/NETICW -- Read a character from the network
C00033 00013 NETOCH -- Output a character to the network
C00034 00014 NETSND -- Force network buffer out
C00036 00015 DATICH/DATICW -- Read a character from the network data channel
C00040 00016 DATOCH -- Output a character to the network data channel
C00041 00017 DATSND -- Force network buffer out
C00043 00018 CLOSER/CLSDAT -- Close a connection
C00044 00019 NETINR/NETINS -- Send network interrupts to TELNET connection
C00045 00020 MTPERR -- Explain MTAPE lossage
C00047 00021 NIOERR -- Explain network I/O lossage
C00048 00022 HSTDED -- Explain why a host is dead
C00050 00023 Hairy "when host up" code
C00052 00024 Host table routines
C00055 00025 Host table definitions
C00057 00026 MAPHST -- Map host table into core
C00059 00027 UNMHST -- Unmap host table from core
C00060 00028 HSTNUM -- Return descriptor block for a host
C00062 00029 HSTNAM -- Return descriptor block for a host name
C00064 00030 Host name search
C00068 00031 SETANM -- Generate alias name from host name
C00072 00032 All good things must come to an end
C00073 ENDMK
C⊗;
SUBTTL Network routines, intended to be .INSRT'ed
; Mark Crispin, SU-AI, June 1978
; This is a library of ARPAnet hacking routines. Each routine describes its
; calling sequence and what AC's it smashes. A pushdown stack is expected in 17.
; I/O channel 0 is smashed, I/O channel 1 (NET) is used as the general TELNET
; connection channel, and I/O channel 2 (DAT) is used for data I/O.
; Bugs → MRC.
; This is the MIDAS version which lives in NETWRK.MID[NET,MRC]. The FAIL version
; lives in NETWRK.FAI[SUB,SYS].
; Assembly switches
IFNDEF SVRRTS,SVRRTS==0 ; ≠ 0 → server (not user) routines
IFNDEF DATRTS,DATRTS==0 ; ≠ 0 → data channel routines
IFNDEF ERRHAN,ERRHAN==0 ; ≠ 0 → automagic error reporting in NIORTS
IFNDEF ERRINS,ERRINS==EXIT ; (iff ERRHAN≠0) what to do after an error
IFNDEF HSTSIX,HSTSIX==0 ; ≠ 0 → sixbit alias name hacking
IFNDEF NIORTS,NIORTS==SVRRTS\DATRTS\ERRHAN ; ≠ 0 → network I/O routines
IFNDEF ERRTNS,ERRTNS==ERRHAN ; ≠ 0 → error reporting routines
IFNDEF HSTTAB,HSTTAB==HSTSIX ; ≠ 0 → host table routines
IFE NIORTS\ERRTNS\HSTTAB,.FATAL No NETWRK routines selected
IFE NIORTS,IFN SVRRTS\DATRTS\ERRHAN,.FATAL NIORTS Illegal switch setting
IFE ERRTNS,IFN ERRHAN,.FATAL ERRHAN Illegal switch setting
IFE HSTTAB,IFN HSTSIX,.FATAL HSTTAB Illegal switch setting
; Macro definitions
; FATAL errors type an exclamation point and halt. WARNings type a question
; mark and continue.
DEFINE FATAL STRING
PUSHJ 17,[OUTSTR [ASCIZ\!STRING!?\] ? JRST LUZBIG]
TERMIN
DEFINE WARN STRING
PUSHJ 17,[OUTSTR [ASCIZ\!STRING!!\] ? JRST WARNIN]
TERMIN
; System bits and bytes
.BEGIN NETWRK
; Interrupt condition bits
.U"INTINR==000100,, ; IMP INR
.U"INTINS==000040,, ; IMP INS
.U"INTIMS==000020,, ; IMP status change
.U"INTINP==000010,, ; IMP input waiting
; Network socket status flags
.U"RFCS== 200000,, ; RFC sent
.U"RFCR== 100000,, ; RFC received
.U"CLSS== 040000,, ; CLS sent
.U"CLSR== 020000,, ; CLS received
; Network I/O status bits
.U"HDEAD== 002000 ; host or destination IMP dead
.U"CTROV== 001000 ; host sent more bits than allocated
.U"RSET== 000400 ; host sent a RST
.U"TMO== 000200 ; time out
; Network status word error codes
.U"SIU==01 ; socket in use
.U"CCS==02 ; can't change socket numbers
.U"SYS==03 ; horrible system error
.U"NLA==04 ; no links available
.U"ILB==05 ; illegal byte size
.U"IDD==06 ; IMP dead
.U"GMM==07 ; Gender mismatch
; I/O status word error bits
.U"IOIMPM==400000 ; improper mode
.U"IODERR==200000 ; hard device error
.U"IODTER==100000 ; soft device error
.U"IOBKTL==040000 ; block number out of bounds
.U"IODEND==020000 ; end of file
ERRBTS==IOIMPM\IODERR\IODTER\IOBKTL\IODEND\HDEAD\CTROV\RSET\TMO ; all I/O lossage
WINBTS==RFCS\RFCR ; connection winning
; I/O channel definitions
ICP==0 ; channel to get socket from logger
.U"NET==1 ; channel to do real network hacking
.U"DAT==2 ; channel to do data hacking
; Data area
NWKDBG: 0 ; -1 → do OUTCHR on network I/O
IFN HSTTAB,[
; Host table pointers
.U"HSTADR: ; ≠ 0 → address of beginning of host table
BLOCK 1 ; = 0 → host table not in core
HSTTOP: BLOCK 1 ; top of host table (JOBFF at map time)
HDBPTR: BLOCK 1 ; pointer to relative HDB
]; End IFN HSTTAB
IFN NIORTS,[
; CONNECT MTAPE block
CONBLK: 0 ; CONNECT
CONSTS: BLOCK 1 ; returned status bits
CONLSK: BLOCK 1 ; local socket
CONWAT: BLOCK 1 ; ≠ 0 → wait for connection until timeout
CONBYT: BLOCK 1 ; byte size
.U"ICPSKT:
CONFSK: BLOCK 1 ; foreign socket
.U"HOST:
CONHST: BLOCK 1 ; foreign host
IFN SVRRTS,[
; LISTEN MTAPE block
LSNBLK: 1 ; LISTEN
LSNSTS: BLOCK 1 ; returned status bits
.U"LSNSKT:
BLOCK 1 ; local socket to listen to
LSNWAT: BLOCK 1 ; ≠ 0 → wait for connection
LSNBYT: BLOCK 1 ; byte size
LSNFSK: BLOCK 1 ; foreign socket
LSNHST: BLOCK 1 ; foreign host
]; End IFN SVRRTS
; More data area, shared by USER and SERVER
; WAIT MTAPE block
WATBLK: 4 ; WAIT
WATSTS: BLOCK 1 ; returned status bits
WATSKT: BLOCK 1 ; socket number
; INTERRUPT MTAPE blocks
INRBLK: 11 ; SEND INTERRUPT
INRSTS: BLOCK 1 ; returned status bits
INRSKT: BLOCK 1 ; socket number
INSBLK: 11
INSSTS: BLOCK 1
INSSKT: BLOCK 1
; Other stuff
WHYWHY: BLOCK 1 ; host down word
; I/O buffer headers
NTIBF: BLOCK 3 ; network input buffer header
NTOBF: BLOCK 3 ; network output buffer header
IFN DATRTS,[
DTIBF: BLOCK 3 ; network data input buffer header
DTOBF: BLOCK 3 ; network data output buffer header
]; End IFN DATRTS
; Base sockets, set up by CONECT and LISTEN
.U"FSOCKT:
BLOCK 1 ; foreign base socket
.U"LSOCKT:
BLOCK 1 ; local base socket
]; End IFN NIORTS
; CONECT -- Connect to foreign host
; Call: MOVEM <host number>,HOST
; MOVEM <ICP socket number>,ICPSKT
; PUSHJ 17,CONECT
; <error return--MTAPE lossage, status in 0> iff ERRHAN = 0
; <error return--I/O error, status in 0> iff ERRHAN = 0
; <return>
; Smashes 0 and 1.
IFN NIORTS,[
IFE SVRRTS,[
; Open channels and set timeouts
.U"CONECT:
IFN ERRHAN,[
PUSHJ 17,.CONEC
JRST [PUSHJ 17,MTPERR ? ERRINS]
JRST [PUSHJ 17,NIOERR ? ERRINS]
POPJ 17,
]; End IFN ERRHAN
.CONEC: INIT ICP,17 ; open ICP in dump mode
'IMP,, ; device IMP:
0 ; no buffers
FATAL IMP INIT failure
MTAPE ICP,[17 ? .BYTE 6 ?1?0?0?15.?5?0]; set timeouts
INIT NET,0 ; open NET in ASCII mode
'IMP,,
NTOBF,,NTIBF ; buffers
FATAL IMP INIT failure
MTAPE NET,[17 ? .BYTE 6 ?1?15.?0?5?0?0]
; Now try to get to the foreign host's logger
SETOM CONLSK ; gensym local socket
SETOM CONWAT ; do wait until timeout
MTAPE ICP,CONBLK ; connect → foreign logger
MOVE CONLSK ; get gensymmed socket
MOVEM LSOCKT ; save local base socket
MOVE CONSTS ; check for MTAPE error
TRNE 77
POPJ 17,
MOVEM WHYWHY
GETSTS ICP, ; check for I/O error
TRNE ERRBTS
JRST CPOPJ1
MOVE WHYWHY
TLC (WINBTS) ; for next instruction to win
TLCE (WINBTS) ; legal socket state?
POPJ 17,
HRROI CONFSK-1 ; get ready to get a socket
SETZ 1, ; stop code for dump mode
; Get socket number from logger
IN ICP, ; get socket from logger
JRST GOTSKT ; won
GETSTS ICP, ; I/O error??!
JRST CPOPJ1
; Got socket number from logger
GOTSKT: LDB [044000,,CONFSK] ; get socket we got
MOVEM CONFSK ; and save it back
MOVEM FSOCKT ; save foreign base socket for later
CLOSE ICP,
RELEAS ICP, ; free up channel
; Now connect output
MOVEI 3 ; ICP/transmit offset
ADDB CONLSK ; local transmit socket
MOVEM WATSKT ; save wait socket
MOVEM INSSKT
SETZM CONWAT ; don't wait
MOVEI 8. ; 8 bit bytes
MOVEM CONBYT
MTAPE NET,CONBLK ; connect ← server output
MOVE CONSTS ; test for error
TRNE 77
POPJ 17,
; Now connect input
SOS CONLSK ; local receive socket
AOS CONFSK ; foreign transmit socket
MTAPE NET,CONBLK ; connect → server input
MOVE CONSTS ; test for error
TRNE 77
POPJ 17,
; Connections started, now wait for output
MTAPE NET,WATBLK ; wait for output
MOVE WATSTS ; get status
TRNE 77
POPJ 17,
MOVEM WHYWHY
GETSTS NET,
TRNE ERRBTS
JRST CPOPJ1
MOVE WHYWHY
TLC (WINBTS)
TLCE (WINBTS)
POPJ 17,
; Output connected, now wait for input
SOS 1,WATSKT ; now select receive socket
MOVEM 1,INRSKT
MTAPE NET,WATBLK ; wait for input
MOVE WATSTS ; get status
TRNE 77
POPJ 17,
MOVEM WHYWHY
GETSTS NET,
TRNE ERRBTS
JRST CPOPJ1
MOVE WHYWHY
TLC (WINBTS)
TLCE (WINBTS)
POPJ 17,
; Set up allocations, buffer headers, and return.
MTAPE NET,[15 ? 1] ; system maximum allocation
MOVEI 8. ; change byte size in buffer header
DPB [300600,,NTIBF+1]
DPB [300600,,NTOBF+1]
INBUF NET,
OUTBUF NET,
MTAPE NET,[10]
JFCL
JRST CPOPJ2
]; End IFE SVRRTS
; LISTEN -- Listen for an ICP from a foreign host
; Call: MOVEM <ICP socket number>,LSNSKT
; PUSHJ 17,LISTEN
; <error return--MTAPE lossage, status in 0> iff ERRHAN = 0
; <error return--I/O error, status in 0> iff ERRHAN = 0
; <return--host we connected to in HOST>
; Smashes 0 and 1.
IFN SVRRTS,[
; Open channels and set timeouts (punts after a minute)
.U"LISTEN:
IFN ERRHAN,[
PUSHJ 17,.LISTE
JRST [PUSHJ 17,MTPERR ? ERRINS]
JRST [PUSHJ 17,NIOERR ? ERRINS]
POPJ 17,
]; End IFN ERRHAN
.LISTE: INIT ICP,17 ; open ICP in dump mode
'IMP,, ; device IMP:
0 ; no buffers
FATAL IMP INIT failure
MTAPE ICP,[17 ? .BYTE 6 ?1?10.?10.?30.?0?0]; set timeouts
INIT NET,0 ; open NET in ASCII mode
'IMP,,
NTOBF,,NTIBF ; buffers
FATAL IMP INIT failure
MTAPE NET,[17 ? .BYTE 6 ?1?15.?0?5?0?0]
; Now wait for the foreign host to send us an RFC
MOVEI 32. ; ICP byte size
MOVEM LSNBYT
SETOM LSNWAT ; do wait until timeout
MTAPE ICP,LSNBLK
MOVE LSNSTS ; check for MTAPE error
TRNE 77
POPJ 17,
MOVEM WHYWHY
GETSTS ICP, ; check for I/O error
TRNE ERRBTS
JRST CPOPJ1
MOVE WHYWHY
TLC (WINBTS) ; for next instruction to win
TLCE (WINBTS) ; legal socket state?
POPJ 17,
MOVE LSNHST
MOVEM CONHST
MOVE LSNFSK
MOVEM FSOCKT ; save foreign base socket
ADDI 3
MOVEM CONFSK
; Gensym a socket
MOVEI 21 ; GENSYM
MTAPE ICP,
MOVEM 1,CONLSK ; connect socket
MOVEM 1,LSOCKT ; local base socket
MOVEM 1,WATSKT ; wait socket
MOVEM 1,INRSKT ; network interrupt socket
DPB 1,[044000,,LSNSKT] ; socket sent to user
; Send socket number to user
HRROI LSNSKT-1 ; get ready to send a socket
SETZ 1, ; stop code for dump mode
OUT ICP,
JRST SNTSKT ; won
GETSTS ICP, ; I/O error??!
JRST CPOPJ1
; Sent socket number to user
SNTSKT: CLOSE ICP,
RELEAS ICP, ; free up channel
; Now connect input
SETZM CONWAT ; don't wait
MTAPE NET,CONBLK ; connect ← user output
MOVE CONSTS ; test for error
TRNE 77
POPJ 17,
; Now connect output
MOVEI 8. ; 8 bit bytes
MOVEM CONBYT
AOS CONLSK ; local receive socket
SOS CONFSK ; foreign transmit socket
MTAPE NET,CONBLK ; connect → user input
MOVE CONSTS ; test for error
TRNE 77
POPJ 17,
; Connections started, now wait for input
MTAPE NET,WATBLK ; wait for input
MOVE WATSTS ; get status
TRNE 77
POPJ 17,
MOVEM WHYWHY
GETSTS NET,
TRNE ERRBTS
JRST CPOPJ1
MOVE WHYWHY
TLC (WINBTS)
TLCE (WINBTS)
POPJ 17,
; Input connected, now wait for output
AOS 1,WATSKT ; now select send socket
MOVEM 1,INSSKT
MTAPE NET,WATBLK ; wait for input
MOVE WATSTS ; get status
TRNE 77
POPJ 17,
MOVEM WHYWHY
GETSTS NET,
TRNE ERRBTS
JRST CPOPJ1
MOVE WHYWHY
TLC (WINBTS)
TLCE (WINBTS)
POPJ 17,
; Set up allocations, buffer headers, and return.
MOVEI 8. ; change byte size in buffer header
DPB [300600,,NTIBF+1]
DPB [300600,,NTOBF+1]
INBUF NET,
OUTBUF NET,
MTAPE NET,[10]
JFCL
JRST CPOPJ2
]; End IFN SVRRTS
; DATI -- Open data input network channel
; Call: PUSHJ 17,DATI
; <error return--MTAPE lossage, status in 0> iff ERRHAN = 0
; <error return--I/O error, status in 0> iff ERRHAN = 0
; <return--byte size in 0>
; Smashes 0 and 1.
IFN DATRTS,[
.U"DATI:
IFN ERRHAN,[
PUSHJ 17,.DATI
JRST [PUSHJ 17,MTPERR ? ERRINS]
JRST [PUSHJ 17,NIOERR ? ERRINS]
POPJ 17,
]; End IFN ERRHAN
.DATI: CHNSTS DAT, ; check for channel open
JUMPN .DATI1
INIT DAT,0 ; open channel
'IMP,,
DTOBF,,DTIBF ; buffers
FATAL IMP INIT failure
MTAPE DAT,[17 ? .BYTE 6 ?2?24?0?7?0?0]
.DATI1: MOVE LSOCKT
ADDI 4 ; ICP/U receive data offset
MOVEM CONLSK ; local receive socket
MOVE FSOCKT
ADDI 3 ; ICP/S transmit data offset
MOVEM CONFSK ; foreign transmit socket
SETOM CONWAT ; wait
MTAPE DAT,CONBLK ; connect ← foreign data output
MOVE CONSTS ; test for error
TRNE 77
POPJ 17,
MOVEM WHYWHY
GETSTS DAT,
TRNE ERRBTS
JRST CPOPJ1
MOVE WHYWHY
TLC (WINBTS)
TLCE (WINBTS)
POPJ 17,
MTAPE DAT,[15 ? 1] ; system maximum allocation
MOVE CONBYT ; change byte size in buffer header
DPB [300600,,DTIBF+1]
INBUF DAT,
MTAPE DAT,[10]
JFCL
JRST CPOPJ2
; DATO -- Open data output network channel
; Call: MOVEI <byte size of connection>
; PUSHJ 17,DATO
; <error return--MTAPE lossage, status in 0> iff ERRHAN = 0
; <error return--I/O error, status in 0> iff ERRHAN = 0
; <return>
; Smashes 0 and 1.
.U"DATO:
IFN ERRHAN,[
PUSHJ 17,.DATO
JRST [PUSHJ 17,MTPERR ? ERRINS]
JRST [PUSHJ 17,NIOERR ? ERRINS]
POPJ 17,
]; End IFN ERRHAN
.DATO: MOVEM CONBYT
CHNSTS DAT,
JUMPN .DATO1
INIT DAT,0 ; open channel
'IMP,,
DTOBF,,DTIBF ; buffers
FATAL IMP INIT failure
MTAPE DAT,[17 ? .BYTE 6 ?2?24?0?7?0?0]
.DATO1: MOVE LSOCKT
ADDI 5 ; ICP/U transmit data offset
MOVEM CONLSK ; local receive socket
MOVE FSOCKT
ADDI 2 ; ICP/S receive data offset
MOVEM CONFSK ; foreign transmit socket
SETOM CONWAT ; wait
MTAPE DAT,CONBLK ; connect → foreign data input
MOVE CONSTS ; test for error
TRNE 77
POPJ 17,
MOVEM WHYWHY
GETSTS DAT,
TRNE ERRBTS
JRST CPOPJ1
MOVE WHYWHY
TLC (WINBTS)
TLCE (WINBTS)
POPJ 17,
MOVE CONBYT ; change byte size in buffer header
DPB [300600,,DTOBF+1]
OUTBUF DAT,
JRST CPOPJ2
]; End IFN DATRTS
; NETICH/NETICW -- Read a character from the network
; Call: PUSHJ 17,NETICH or PUSHJ 17,NETICW
; <error return--I/O error, status in 0> iff ERRHAN = 0
; <error return--no characters available> iff NETICH
; <return--character in 0>
; Smashes 0, 1, and 2.
.U"NETICH:
TDZA 2,2 ; don't hang
.U"NETICW:
SETO 2, ; hang
IFN ERRHAN,[
PUSHJ 17,NTICH2
JRST [PUSHJ 17,NIOERR ? ERRINS]
POPJ 17, ; NETICW or empty NETICH
JRST CPOPJ1 ; NETICH return
]; End IFN ERRHAN
NTICH2: SOSLE NTIBF+2 ; anything in buffer?
JRST NTICH3
JUMPE 2,[ HRRZ 1,NTIBF
HRRZ 1,(1)
SKIPGE (1) ; anything in further buffers?
JRST .+1
MTAPE NET,[10] ; no, any input available?
JRST CPOPJ1 ; no, empty error return
JRST .+1] ; input available or hang
IN NET, ; yes, read the buffer
JRST NTICH3 ; won
GETSTS NET, ; error, get status
POPJ 17, ; I/O error return
NTICH3: IBP NTIBF+1 ; increment pointer to hack
MOVE @NTIBF+1 ; get word to hack
ANDI 17 ; only marking bits
JFFO NTICH1 ; count leading zeros
LDB NTIBF+1 ; get the character
SKIPE NWKDBG
OUTCHR
JUMPN 2,CPOPJ1 ; NETICW only skips once
JRST CPOPJ2 ; NETICH good return
; Have to flush nulls here.
NTICH1: MOVNI 1,-44(1) ; get -1,,# of padding characters
HRRZM 1,1(17) ; stash # of characters away on stack
MOVEI 1,-1(1) ; # of characters to take off buffer
SUBM 1,NTIBF+2 ; remove padding characters from count
MOVNS NTIBF+2 ; SUBM goes the wrong way
ADJBP 1,NTIBF+1 ; move byte pointer
MOVEM 1,NTIBF+1 ; save pointer
MOVN 1,1(17) ; get # of characters back from stack
LSH 1,3 ; # of bits to shift over
MOVE @NTIBF+1 ; get word we are hacking
LSH (1) ; right justify its bytes
MOVEM @NTIBF+1 ; store it back again
JRST NTICH2 ; now try it again
; NETOCH -- Output a character to the network
; Call: MOVE <character>
; PUSHJ 17,NETOCH
; <error return--I/O error, status in 0> iff ERRHAN = 0
; <return>
; Smashes 0.
.U"NETOCH:
IFN ERRHAN,[
PUSHJ 17,.NETOC
JRST [PUSHJ 17,NIOERR ? ERRINS]
POPJ 17,
]; End IFN ERRHAN
.NETOC: SOSG NTOBF+2 ; space available in buffer?
OUT NET, ; no, output it
CAIA ; win
JRST NETOER
IDPB NTOBF+1 ; put character in buffer
SKIPE NWKDBG
OUTCHR
JRST CPOPJ1 ; success
; NETSND -- Force network buffer out
; Call: PUSHJ 17,NETSND
; <error return--I/O error, status in 0> iff ERRHAN = 0
; <return>
; Smashes 0 and 1.
.U"NETSND:
IFN ERRHAN,[
PUSHJ 17,.NETSN
JRST [PUSHJ 17,NIOERR ? ERRINS]
POPJ 17,
]; End IFN ERRHAN
.NETSN: LDB 1,[410300,,NTOBF+1] ; get position field
MOVEI 1
LSH (1) ; AC0 ← 2↑<# of null characters>
SOS ; AC0 ← mask to flush nulls
IORM @NTOBF+1 ; ensure padding nulls aren't sent
OUT NET, ; send the buffer
JRST [ AOS NTOBF+2 ; poor NETOCH will lose big otherwise
JRST CPOPJ1]
NETOER: GETSTS NET, ; lost, get status
POPJ 17, ; and return
; DATICH/DATICW -- Read a character from the network data channel
; Call: PUSHJ 17,DATICH or PUSHJ 17,DATICW
; <error return--I/O error, status in 0> iff ERRHAN = 0
; <error return--no characters available> iff DATICH
; <return--character in 0>
; Smashes 0, 1, and 2.
IFN DATRTS,[
.U"DATICH:
TDZA 2,2 ; don't hang
.U"DATICW:
SETO 2, ; hang
IFN ERRHAN,[
PUSHJ 17,DTICH2
JRST [PUSHJ 17,NIOERR ? ERRINS]
POPJ 17, ; DATICW or empty DATICH
JRST CPOPJ1 ; DATICH return
]; End IFN ERRHAN
DTICH2: SOSLE DTIBF+2 ; anything in buffer?
JRST DTICH3
JUMPE 2,[ HRRZ 1,DTIBF
HRRZ 1,(1)
SKIPGE (1) ; anything in further buffers?
JRST .+1
MTAPE DAT,[10] ; no, any input available?
JRST CPOPJ1 ; no, empty error return
JRST .+1] ; input available or hang
IN DAT, ; yes, read the buffer
JRST DTICH3 ; won
GETSTS DAT, ; error, get status
POPJ 17, ; I/O error return
DTICH3: LDB [300600,,DTIBF+1] ; get byte size
CAIE 8.
JRST [ ILDB DTIBF+1 ; non-ASCII data mode
JUMPN 2,CPOPJ1
JRST CPOPJ2]
IBP DTIBF+1 ; increment pointer to hack
MOVE @DTIBF+1 ; get word to hack
ANDI 17 ; only marking bits
JFFO DTICH1 ; count leading zeros
LDB DTIBF+1 ; get the character
JUMPN 2,CPOPJ1 ; DATICW only skips once
JRST CPOPJ2 ; DATICH good return
; Have to flush nulls here.
DTICH1: MOVNI 1,-44(1) ; get -1,,# of padding characters
HRRZM 1,1(17) ; stash # of characters away on stack
MOVEI 1,-1(1) ; # of characters to take off buffer
SUBM 1,DTIBF+2 ; remove padding characters from count
MOVNS DTIBF+2 ; SUBM goes the wrong way
ADJBP 1,DTIBF+1 ; move byte pointer
MOVEM 1,DTIBF+1 ; save pointer
MOVN 1,1(17) ; get # of characters back from stack
LSH 1,3 ; # of bits to shift over
MOVE @DTIBF+1 ; get word we are hacking
LSH (1) ; right justify its bytes
MOVEM @DTIBF+1 ; store it back again
JRST DTICH2 ; now try it again
; DATOCH -- Output a character to the network data channel
; Call: MOVE <character>
; PUSHJ 17,DATOCH
; <error return--I/O error, status in 0> iff ERRHAN = 0
; <return>
; Smashes 0.
.U"DATOCH:
IFN ERRHAN,[
PUSHJ 17,.DATOC
JRST [PUSHJ 17,NIOERR ? ERRINS]
POPJ 17,
]; End IFN ERRHAN
.DATOC: SOSG DTOBF+2 ; space available in buffer?
OUT DAT, ; no, output it
CAIA ; win
JRST DATOER
IDPB DTOBF+1 ; put character in buffer
JRST CPOPJ1 ; success
; DATSND -- Force network buffer out
; Call: PUSHJ 17,DATSND
; <error return--I/O error, status in 0> iff ERRHAN = 0
; <return>
; Smashes 0 and 1.
.U"DATSND:
IFN ERRHAN,[
PUSHJ 17,.DATSN
JRST [PUSHJ 17,NIOERR ? ERRINS]
POPJ 17,
]; End IFN ERRHAN
.DATSN: LDB 1,[410300,,DTOBF+1] ; get position field
MOVEI 1
LSH (1) ; AC0 ← 2↑<# of null characters>
SOS ; AC0 ← mask to flush nulls
IORM @DTOBF+1 ; ensure padding nulls aren't sent
OUT DAT, ; send the buffer
JRST [ AOS DTOBF+2 ; poor NETOCH will lose big otherwise
JRST CPOPJ1]
DATOER: GETSTS DAT, ; lost, get status
POPJ 17, ; and return
]; End IFN DATRTS
; CLOSER/CLSDAT -- Close a connection
; Call: PUSHJ 17,CLOSER or PUSHJ 17,CLSDAT
; <return>
; Smashes 0.
.U"CLOSER:
CLOSE NET,
RELEASE NET,
OUTSTR [ASCIZ/
Connection closed.
/]
POPJ 17,
IFN DATRTS,[
.U"CLSDAT:
CLOSE DAT,
RELEASE DAT,
POPJ 17,
]; End IFN DATRTS
; NETINR/NETINS -- Send network interrupts to TELNET connection
; Call: PUSHJ 17,NETINR (or NETINS)
; <return>
; Smashes 0.
.U"NETINR:
MTAPE NET,INRBLK ; interrupt from receiver
POPJ 17,
.U"NETINS:
MTAPE NET,INSBLK ; interrupt from sender
POPJ 17,
]; End IFN NIORTS
; MTPERR -- Explain MTAPE lossage
; Call: MOVE <MTAPE status bits>
; PUSHJ 17,MTPERR
; <return>
; Smashes 0 and 1.
IFN ERRTNS,[
.U"MTPERR:
TRNE 77 ; UUO lossage?
JRST MTPER1 ; yes, different message
TLNN (CLSR) ; closed by foreign host?
SKIPA 1,[[ASCIZ/Time out
/]]
MOVEI 1,[ASCIZ/Refused
/]
OUTSTR (1)
CLRBFI
POPJ 17,
; MTAPE UUO lossage
MTPER1: ANDI 77 ; only error code
CAILE MERLEN ; error code too high?
JRST [ OUTSTR [ASCIZ/MTAPE error #/]
IDIVI 10
ADDI "0
ADDI 1,"0
OUTCHR
OUTCHR 1
JRST MTPE1A]
MOVE 1,
OUTSTR @MERTAB-1(1) ; output the error string
CAIE 1,NLA
CAIN 1,IDD
CAIA
MTPE1A: WARN
CLRBFI
POPJ 17,
MERTAB: [ASCIZ/Socket in use/]
[ASCIZ/Can't change socket/]
[ASCIZ/System error/] ; horrible IMPSER bug; RTS&STR but no DDB
[ASCIZ/No free links/]
[ASCIZ/Illegal byte size/]
[ASCIZ/NCP dead/]
[ASCIZ/Gender mismatch/] ; the Anita Bryant feature
MERLEN==.-MERTAB
; NIOERR -- Explain network I/O lossage
; Call: MOVE <I/O status bits>
; PUSHJ 17,NIOERR
; <return>
; Smashes 0, 1, and 2.
.U"NIOERR:
ANDI ERRBTS ; only error bits
SKIPN
FATAL No error status
CLRBFI
TRNE IOIMPM\IOBKTL
FATAL IOIMPM or IOBKTL
TRNE CTROV
WARN Allocation error
TRNE RSET
OUTSTR [ASCIZ/Host reset
/]
TRNE TMO
OUTSTR [ASCIZ/Time out
/]
TRNE IODEND
OUTSTR [ASCIZ/Host closed connection
/]
TRZE IODERR
TRO IODTER
CAIN IODTER
OUTSTR [ASCIZ/Incomplete transmission
/]
TRNE HDEAD
JRST HSTDED
POPJ 17,
; HSTDED -- Explain why a host is dead
HSTDED: LDB [260400,,WHYWHY] ; get what's wrong first
JUMPE [ OUTSTR [ASCIZ/Net trouble
/]
POPJ 17,] ; 0 → destination IMP down
SOJE HSTDE1 ; 1 → destination host down
CAIE 2 ; 3 → host access prohibited
JRST [ OUTSTR [ASCIZ/Net error #/]
IDIVI 10
ADDI "0
ADDI 1,"0
OUTCHR
OUTCHR 1
JRST MTPE1A]
OUTSTR [ASCIZ/Communication prohibited!
/]
POPJ 17,
HSTDE1: OUTSTR [ASCIZ/Host dead, /]
LDB 1,[220400,,WHYWHY] ; dead host status
OUTSTR @(1)[ [ASCIZ/random lossage/]
[ASCIZ/system down/]
[ASCIZ/foreign NCP down/]
[ASCIZ/host doesn't exist/]
[ASCIZ/NCP initialization/]
[ASCIZ/scheduled PM/]
[ASCIZ/hardware work/]
[ASCIZ/software work/]
[ASCIZ/emergency restart/]
[ASCIZ/power failure/]
[ASCIZ/software breakpoint/]
[ASCIZ/hardware error/]
[ASCIZ/scheduled down/]
[ASCIZ/down code #13/]
[ASCIZ/down code #14/]
[ASCIZ/coming up now/]]
OUTSTR [ASCIZ/
/]
; Hairy "when host up" code
LDB [061400,,WHYWHY] ; get time when back up
JUMPE CPOPJ
CAIN 7776 ; -2 → unknown future time
POPJ 17,
OUTSTR [ASCIZ/ Host is expected back up /]
CAIN 7777 ; -1 → more than a week
JRST [ OUTSTR [ASCIZ/over a week from now./]
POPJ 17,]
LDB 1,[040500,,] ; 1.5→1.9 hours
LDB 2,[110300,,] ; 2.1→2.3 day of week
SUBI 1,8. ; PST/GMT offset
MOVEI 3,261 ; DAYLIT
PEEK 3,
PEEK 3,
SKIPE 3
AOSL 1 ; daylight losing time
JUMPGE 1,HSTDE2
ADDI 1,24. ; hours become positive again
SOJGE 2,HSTDE2 ; back up a day
MOVEI 2,6
HSTDE2: OUTSTR @(2)[ [ASCIZ/on Monday at /]
[ASCIZ/on Tuesday at /]
[ASCIZ/on Wednesday at /]
[ASCIZ/on Thursday at /]
[ASCIZ/on Friday at /]
[ASCIZ/on Saturday at /]
[ASCIZ/on Sunday at /]
[ASCIZ/on April Fool's Day at /]]
IDIVI 1,10.
ADDI 1,"0
OUTCHR 1
ADDI 2,"0
OUTCHR 2
OUTCHR [":]
LDB 1,[000400,,] ; 1.1→1.4 minutes/5
IMULI 1,5. ; make into real minutes
IDIVI 1,10.
ADDI 1,"0
OUTCHR 1
ADDI 2,"0
OUTCHR 2
JUMPE 3,[ OUTSTR [ASCIZ/ PST
/]
POPJ 17,]
OUTSTR [ASCIZ/ PDT
/]
POPJ 17,
]; End IFN ERRTNS
; Host table routines
IFN HSTTAB,[
COMMENT ⊗
The format of the host table binary file is:
word 0 SIXBIT /HOSTS1/
word 1 SIXBIT /HOSTS/
word 2 version HOSTS file which this was compiled from.
word 3 user name of person who compiled this generation of the host table
word 4 Date of compilation as sixbit YYMMDD
word 5 Time of compilation as sixbit HHMMSS
word 6 Address in file of NAME table.
word 7 Address in file of NUMBER table.
NUMBERS table:
word 0 Number of entries in this table.
word 1 Number of words per entry (currently 3).
followed by entries, in order by host number.
Each entry looks like this:
word 0 host number
word 1 LH pointer to system name (ITS, TIP, TENEX, etc.)
May be 0 → not known.
word 1 RH pointer to official name of host.
word 2 LH flags:
4.9 1 → server site.
word 2 RH pointer to machine name (PDP10, etc).
May be 0 → not known.
...
NAMES table:
word 0 Number of entries
followed by one word entries, sorted by the host name treated as a vector of
signed integers, looking like:
word 0 LH address in file of NUMBERS table entry for this host.
RH pointer to host name
...
Host, system and machine names are ASCIZ strings, all letters upper case.
The strings are stored before, after and between the NAME and NUMBER tables.
⊗
; Host table definitions
; Table header
HSTSID==0 ; SIXBIT /HOSTS1/
HSTFN1==1 ; SIXBIT /HOSTS/
HSTVRS==2 ; FN2 of HOSTS file (if compiled at MIT)
HSTWHO==3 ; User name of person who compiled
HSTDAT==4 ; Date of compilation as sixbit YYMMDD
HSTTIM==5 ; Time of compilation as sixbit HHMMSS
NAMPTR==6 ; Address in file of NAMES table.
NUMPTR==7 ; Address in file of NUMBERS table.
; NUMBERS table
NUMNUM==0 ; host number
NUMSYS==1 ; LH pointer to system name
NUMNAM==1 ; RH pointer to official name of host.
NUMBTS==2 ; LH flags:
NUMSRV==400000 ; 4.9 → server site.
NUMMCH==2 ; RH pointer to machine name
; NAMES table
NAMNAM==0 ; <numbers pointer,,host name pointer>
; MAPHST -- Map host table into core
; Call: PUSHJ 17,MAPHST
; <return>
; Smashes 0, 1, 2, and 3.
.U"MAPHST:
SKIPE HSTADR
JRST [ WARN Host table already mapped
POPJ 17,]
OPEN [17 ? 'DSK,, ? 0] ; get a disk channel
FATAL DSK OPEN failure
DMOVE [SIXBIT/HOSTS1BIN/] ? DMOVE 2,[0 ? 'NETMRC]
LOOKUP ; find file HOSTS1.BIN[NET,MRC]
JRST [ OUTSTR [ASCIZ/Host table LOOKUP failure (/]
ANDI 1,77
IDIVI 1,10
ADDI 1,"0 ? ADDI 2,"0
OUTCHR 1 ? OUTCHR 2 ? OUTCHR [")]
JRST LUZBIG]
MOVE 2,JOBFF
MOVS 3 ? MOVN ? ADDB JOBFF ; get address of highest addr we need
MOVEM HSTTOP
CORE ; get more core from system maybe
FATAL CORE UUO failure
MOVE 3 ? HRRI -1(2) ; compute IOWD to read host table in
SETZ 1,
INPUT
MOVE (2) ; get first word of host table
CAME ['HOSTS1]
FATAL Bad host table
MOVEM 2,HSTADR ; remember where host table begins
RELEAS
POPJ 17,
; UNMHST -- Unmap host table from core
; Call: PUSHJ 17,UNMHST
; <return>
; Smashes 0 and 1.
.U"UNMHST:
SKIPN 1,HSTADR ; host table in core?
JRST [ WARN Host table not mapped
POPJ 17,]
MOVE (1)
CAME ['HOSTS1]
FATAL Bad host table
MOVE HSTTOP ; check JOBFF from before
CAMLE JOBFF ; smashed too?
FATAL Host table after JOBFF
CAME JOBFF
JRST [ WARN Host table locked
POPJ 17,]
SETZM HSTADR ; remove table pointer/interlock
MOVEM 1,JOBFF ; return host table to free storage
CORE 1, ; and garbage collect
FATAL CORE UUO failure
POPJ 17,
; HSTNUM -- Return descriptor block for a host
; Call: MOVEI <host number>
; PUSHJ 17,HSTNUM
; <error return--no such host>
; <return--absolute NAMNUM in 0, NUMSYS,,NUMNAM in 1, NUMBTS,,NUMMCH in 2>
; Smashes 0, 1, 2, 3, and 4.
.U"HSTNUM:
SKIPN 1,HSTADR ; fail if host table not mapped
FATAL Host table not mapped
MOVE 2,(1)
CAME 2,['HOSTS1]
FATAL Bad host table
CAILE 377 ; old style host?
JRST HSTNU0
DPB [170600,,] ; convert to new style
LSH -6
HSTNU0: MOVE 1,NUMPTR(1)
ADD 1,HSTADR ; address of NUMBERS table
MOVE 2,(1) ; get # of entries
MOVE 3,1(1) ; and entry size
ADDI 1,2 ; point at first entry
HSTNU1: MOVE 4,(1)
CAILE 4,377 ; old style host?
JRST HSTNU2
DPB 4,[170600,,4] ; convert to new style
LSH 4,-6
HSTNU2: CAMN 4 ; found host?
JRST [ AOS (17) ; yes, set up skip return
JRST GETHDB] ; and set up the block
ADD 1,3 ; point at next entry
SOJG 2,HSTNU1 ; keep on searching
SETZM HDBPTR ; no HDB
MOVEI 1,[ASCIZ/RANDOM-PLACE/] ; name for unknown hosts
SETZ 2,
POPJ 17, ; failure
; HSTNAM -- Return descriptor block for a host name
; Call: MOVEI <pointer to host name string>
; PUSHJ 17,HSTNAM
; <error return--no such host>
; <error return--ambiguous name>
; <return--absolute NAMNUM in 0, NUMSYS,,NUMNAM in 1, NUMBTS,,NUMMCH in 2>
; Smashes 0 → 10 (!!!).
.U"HSTNAM:
SKIPN 1,HSTADR ; fail if host table not mapped
FATAL Host table not mapped
MOVE 2,(1)
CAME 2,['HOSTS1]
FATAL Bad host table
; Set up various AC's for hairy search below. 0 has a pointer to the input
; host, 1 has the host table pointer, 2 has the character count.
MOVE 2,NAMPTR(1)
ADD 2,HSTADR ; address of NAMES table
HRLO 1,(2) ; # of entries,,-1
EQVI 1,(2) ; -<1+# of entries>,,table-1
ADJSP 1,1 ; now have AOJBN pointer to table
MOVE 3,
HRLI 3,440700 ; make byte pointer
SETZ 2, ; character count
; Compute character count in AC 2
CNTCHR: ILDB 4,3
JUMPE 4,[ JUMPE 2,CPOPJ ; null specification loses
SETZB 3,4 ; init pointers
JRST SEARCH]
CAIL 4,"a ; lowercase?
SUBI 4,"a-"A
DPB 4,3
AOJA 2,CNTCHR
; Host name search
SEARCH: MOVEI 5,(2) ; copy of count
MOVE 6, ; copy of source pointer
HRRZ 7,(1)
ADD 7,HSTADR ; pointer for this entry
SRCNXW: MOVE 10,(7)
MOVE 11,(6)
ANDCMI 11,1 ; 1.1 is a loser
CAIL 5,5. ; account for this word
JRST [ CAME 10,11 ; match for this word?
JRST SRCLUZ
SUBI 5,5. ; match, account for this word
ADDI 7,1
AOJA 6,SRCNXW] ; still more to go
AND 11,[.BYTE 7 ? 177 ? 000 ? 000 ? 000 ? 000
.BYTE 7 ? 177 ? 000 ? 000 ? 000 ? 000
.BYTE 7 ? 177 ? 177 ? 000 ? 000 ? 000
.BYTE 7 ? 177 ? 177 ? 177 ? 000 ? 000
.BYTE 7 ? 177 ? 177 ? 177 ? 177 ? 000](5)
CAMN 10,11 ; exact match?
JRST [ HLRZ 1,(1) ? ADD 1,HSTADR
JRST GOTNAM] ; stop the presses!
SOJL 5,SRCWIN ; this string ends on word boundry
AND 10,[.BYTE 7 ? 177 ? 000 ? 000 ? 000 ? 000
.BYTE 7 ? 177 ? 177 ? 000 ? 000 ? 000
.BYTE 7 ? 177 ? 177 ? 177 ? 000 ? 000
.BYTE 7 ? 177 ? 177 ? 177 ? 177 ? 000](5)
CAME 10,11 ; match for partial word?
JRST SRCLUZ
SRCWIN: HLRZ 5,(1) ? ADD 5,HSTADR ; set up pointer to HDB
MOVE 6,2(5) ; NUMBTS
TLNE 6,NUMSRV ; server?
JRST [ CAMN 3,5 ; all self-matches win
JRST SRCLUZ
SKIPE 3 ; somebody there?
TLOA 3,-1 ; yah, loser
MOVE 3,5 ; else remember the name
AOBJN 1,SEARCH ; keep on hunting
JRST SRCDUN] ; else done
CAMN 4,5 ; self-matcher?
JRST SRCLUZ
SKIPE 4 ; already seen a user?
TLOA 4,-1 ; remember can't be a user
MOVE 4,5 ; else remember the pointer
SRCLUZ: AOBJN 1,SEARCH ; maybe could be a server in there
; Search done, set up HDB ala HSTNUM and return
SRCDUN: SKIPN 1,3 ; use server if found one
MOVE 1,4 ; no server, maybe a user
JUMPE 1,CPOPJ ; no match at all
SKIPL 1 ; ambiguous name?
GOTNAM: AOS (17) ; no, set up double skip return
AMBNAM: AOS (17) ; ordinary skip return
; Routine to get a block of host specifications with pointer in 1.
MOVE (1) ; host number
CAILE 377 ; old style host?
JRST GETHDB
DPB [170600,,] ; convert to new style
LSH -6
GETHDB: MOVE 2,2(1) ; NUMBTS,,NUMMCH
TRNE 2,-1
ADD 2,HSTADR
MOVEM 1,HDBPTR ; save pointer to HDB
SUB 1,HSTADR
EXCH 1,HDBPTR
MOVE 1,1(1) ; NUMSYS,,NUMNAM
TLNN 1,-1
JRST [ ADD 1,HSTADR ; case of unknown system name
POPJ 17,]
ADJSP 1,@HSTADR
POPJ 17, ; and return
; SETANM -- Generate alias name from host name
; Call: <call to HSTNUM or HSTNAM to set up HDB pointer>
; PUSHJ 17,SETANM
; Smashes 0 → 7 (!!!).
IFN HSTSIX,[
.U"SETANM:
HRRZ 6,1 ; check official name first
SKIPN 1,HDBPTR
JRST [ LSHC -6 ; separate 3 octal digits by 3 blank bits
LSH 3
LSHC 3
LSH 3
LSHC 3
IOR ['HST000]
JRST SETAN8]
MOVE 2,HSTADR
HRRZ 2,NAMPTR(2) ; get address of NAMES table.
ADD 2,HSTADR
MOVE 3,(2) ; number of entries in the table.
SETOB 4,5 ; 4 ← longest name ≤ 6 chars, 5 ← length
JRST SETAN0
SETAN1: ADDI 2,1 ; next untried NAMES table entry.
HLRZ 6,(2)
CAME 6,1 ; name the host we are serving?
JRST SETAN4
HRRZ 6,(2) ; how long is this name?
ADD 6,HSTADR
SETAN0: HRLI 6,440700
PUSH 17,6
PUSH 17,6
SETZ 7,
SETAN2: ILDB 6,(17)
SKIPE 6
AOJA 7,SETAN2
POP 17,6 ; flush garbage
POP 17,6 ; restore pointer to name
CAIG 7,6 ; fit in 6 characters?
CAMG 7,4 ; and longer than the previous one?
JRST SETAN4
HRRZ 5,6 ; save name's address
MOVE 4,7 ; and the length
SETAN4: SOJG 3,SETAN1 ; look through the rest of the table.
JUMPGE 4,SETAN5 ; jump if found a reasonable name
MOVE 5,HDBPTR
ADD 5,HSTADR ; no short name, truncate official one
MOVEI 4,"- ; also, will remove hyphens from it
HRRZ 5,NUMNAM(5)
ADD 5,HSTADR ; pointer to name
SETAN5: MOVE 2,5
HRLI 2,440700 ; get BP to name string.
MOVSI 1,440600
SETZ ; convert name to SIXBIT word in 0
SETAN6: ILDB 3,2
JUMPE 3,SETAN7 ; stop if name string runs out
CAMN 3,4 ; remove hyphens if requested to
JRST SETAN6 ; note 4 has number from 1 to 6 or "-
SUBI 3,<" >-<' >
IDPB 3,1
TLNE 1,770000 ; stop after getting one full word.
JRST SETAN6
SETAN7: LDB 3,1 ; if last character is a hyphen, flush it.
CAIN 3,'-
SETZ 3,
DPB 3,1
SETAN8: TRNN -1
IORI '.
SETO 1,
GETLIN 1
AOSN 1 ; don't screw DSK PPN if not a phantom
DSKPPN
POPJ 17,
]; End IFN HSTSIX
]; End IFN HSTTAB
; All good things must come to an end
; Return routines
CPOPJ2: AOS (17) ; double skip return
CPOPJ1: AOS (17) ; skip return
CPOPJ: POPJ 17, ; return to caller
; Warning
.U"WARNIN:
OUTSTR [ASCIZ/
Please report this via GRIPE.
/]
POPJ 17,
; Fatality!
.U"LUZBIG:
OUTSTR [ASCIZ/
Find a wizard.
/]
JRST 4,WARNIN
..NLIT: CONSTANTS
.END NETWRK